home *** CD-ROM | disk | FTP | other *** search
/ Programming Languages Suite / ProgLangD.iso / TURBOPASCAL WIN / PAINT.PAK / CANVAS.PAS < prev    next >
Pascal/Delphi Source File  |  1992-06-08  |  21KB  |  737 lines
  1. {************************************************}
  2. {                                                }
  3. {   Turbo Pascal for Windows: Paint Demo         }
  4. {   Canvas unit                                  }
  5. {   Copyright (c) 1992 by Borland International  }
  6. {                                                }
  7. {************************************************}
  8.  
  9. unit Canvas;
  10.  
  11. { This unit supplies the drawing canvas for the paint program, that is, the
  12.   window where drawing actually takes place.
  13.  
  14.   The Canvas is responisble for maintaining the screen state, including
  15.   updating the cursor, directing input to the currently selected drawing
  16.   tool and managing the enabling of certain menu items (cut/copy/paste/etc).
  17. }
  18.  
  19. interface
  20.  
  21. uses PaintDef, ResDef, Bitmaps,
  22.      WinTypes, WinProcs, WObjects, Strings;
  23.  
  24. type
  25.  
  26.   PCanvas = ^TCanvas;
  27.   TCanvas = object(TWindow)
  28.     State: PState;
  29.  
  30.     Bitmap: HBitmap;        { Save the bitmap originally in State^.MemDC }
  31.     UndoBitmap: HBitmap;    { Saved bitmap for undoing }
  32.     UndoDC: HDC;        { Display context for undoing }
  33.  
  34.     Drawing: Boolean;        { In the process of drawing }
  35.     OverSelection: Boolean;    { Cursor is the 'over selection' cursor }
  36.  
  37.     { Creation and destruction }
  38.     constructor Init(AParent: PWindowsObject; AState: PState);
  39.     destructor Done; virtual;
  40.     procedure SetupWindow; virtual;
  41.     procedure NewBitmaps(DC: HDC);
  42.  
  43.     { Display }
  44.     procedure MoveSelf(WX, WY, WW, WH: Integer; Repaint: Boolean);
  45.     procedure Paint(PaintDC: HDC; var PaintInfo: TPaintStruct); virtual;
  46.     procedure PaintSelection(DC: HDC; AddOffset: Boolean);
  47.     procedure SaveUndo;
  48.  
  49.     { Menu management }
  50.     { Cut/Copy/Paste }
  51.     procedure EnableCCDMenu(mf_Flag: Integer);
  52.     procedure EnableCCD;
  53.     procedure DisableCCD;
  54.  
  55.     { Undo/Redo }
  56.     procedure EnableUndoMenu(mf_Flag: Integer);
  57.     procedure EnableUndo;
  58.     procedure DisableUndo;
  59.     procedure ResetUndoLabel(NewLabel: PChar);
  60.  
  61.     { Menu initiated actions }
  62.     { File }
  63.     procedure Undo;
  64.     function Load(FileName: PChar): Integer;
  65.     function Store(FileName: PChar): Integer;
  66.  
  67.     { Edit }
  68.     procedure CopyToClipBoard(DC: HDC; Left, Top, Width, Height: Integer);
  69.     procedure Erase(Left, Top, Width, Height: Integer);
  70.     procedure PickUpSelection(aDC: HDC; Left, Top, Width, Height: Integer);
  71.     procedure ReleaseSelection;
  72.  
  73.     procedure Cut;
  74.     procedure Copy;
  75.     procedure Paste;
  76.     procedure Delete;
  77.     procedure ClearAll;
  78.  
  79.     { Options }
  80.     procedure Resize(CopyFlag: Integer);
  81.     procedure BitmapCopy(aBitmap: HBitmap; CopyFlag: Integer);
  82.  
  83.     { Window manager responses }
  84.     { Mouse initiated actions }
  85.     procedure WMLButtonDown(var Msg: TMessage);
  86.       virtual wm_First + wm_LButtonDown;
  87.     procedure WMLButtonUp(var Msg: TMessage);
  88.       virtual wm_First + wm_LButtonUp;
  89.     procedure WMMouseMove(var Msg: TMessage);
  90.       virtual wm_First + wm_MouseMove;
  91.     procedure wmSetCursor(var Msg: TMessage);
  92.       virtual wm_First + wm_SetCursor;
  93.  
  94.   end;
  95.  
  96.   PCanvasScroller = ^TCanvasScroller;
  97.   TCanvasScroller = object(TScroller)
  98.     procedure BeginView(PaintDC: HDC; var PaintInfo: TPaintStruct); virtual;
  99.   end;
  100.  
  101. implementation
  102.  
  103. { Create a new canvas and initialize the selection.
  104. }
  105. constructor TCanvas.Init(AParent: PWindowsObject; AState: PState);
  106. var
  107.   DC: HDC;
  108. begin
  109.   TWindow.Init(AParent, nil);
  110.   Attr.Style := ws_Border or ws_Child or ws_Visible
  111.         or ws_HScroll or ws_VScroll;
  112.   Scroller := New(PCanvasScroller, Init(@Self, 1, 1, 200, 200));
  113.   State := AState;
  114.   
  115.   { Initialize the selection }
  116.   SetRectEmpty(State^.Selection);
  117.   State^.SelectionBM := 0;
  118.  
  119.   Drawing := False;
  120.   OverSelection := False;
  121.  
  122.   State^.IsDirtyBitmap := False;
  123. {  DisableUndo;}
  124.  
  125.   { Set up the display contexts }
  126.   DC := GetDC(0);
  127.   State^.MemDC := CreateCompatibleDC(DC);
  128.   UndoDC       := CreateCompatibleDC(DC);
  129.  
  130.   { Create the bitmaps }
  131.   NewBitmaps(DC);
  132.  
  133.   ReleaseDC(0, DC);
  134. end;
  135.  
  136. { Destroy the off-screen bitmaps before dying.
  137. }
  138. destructor TCanvas.Done;
  139. begin
  140.   DeleteObject(SelectObject(State^.MemDC, Bitmap));
  141.   DeleteObject(SelectObject(UndoDC, UndoBitmap));
  142.   DeleteDC(State^.MemDC);
  143.   DeleteDC(UndoDC);
  144.   if State^.SelectionBM <> 0 then DeleteObject(State^.SelectionBM);
  145.   TWindow.Done;
  146. end;
  147.  
  148. procedure TCanvas.SetupWindow;
  149. begin
  150.   TWindow.SetupWindow;
  151.   DisableUndo;
  152. end;
  153.  
  154. { Set up new bitmaps for the canvas. It is assumed that the DCs have already
  155.   been set up appropriately.
  156. }
  157. procedure TCanvas.NewBitmaps(DC: HDC);
  158. begin
  159.   with State^.BitmapSize do
  160.     begin
  161.       Bitmap     := SelectObject(State^.MemDC, 
  162.                          CreateCompatibleBitmap(DC, X, Y));
  163.       UndoBitmap := SelectObject(UndoDC, 
  164.                              CreateCompatibleBitmap(DC, X, Y));
  165.  
  166.       { White them out }
  167.       PatBlt(State^.MemDC, 0, 0, X, Y, whiteness);
  168.       PatBlt(UndoDC,       0, 0, X, Y, whiteness);
  169.    end;
  170. end;
  171.  
  172. { Display }
  173. { Move and resize the window. Adjust the Scroller as needed.
  174. }
  175. procedure TCanvas.MoveSelf(WX, WY, WW, WH: Integer; Repaint: Boolean);
  176. var
  177.   XRange, YRange: Integer;
  178. begin
  179.   with State^.BitmapSize do
  180.   begin
  181.     if WW > X + 2 then
  182.     begin
  183.       XRange := 0;
  184.       WW := X + 2;
  185.     end
  186.     else
  187.       XRange := X - WW;
  188.  
  189.     if WH > Y + 2 then
  190.     begin
  191.      YRange := 0;
  192.      WH := Y + 2;
  193.     end
  194.     else
  195.       YRange := Y - WH;
  196.   end;
  197.  
  198.   { Windows' MoveWindow does not repaint the window if the given
  199.     coordinates are exactly the same as the current coordinates. }
  200.   if (Attr.X = WX) and (Attr.Y = WY) and (Attr.W = WW)
  201.      and (Attr.H = WH) and Repaint then
  202.     InvalidateRect(HWindow, nil, True)
  203.   else
  204.     MoveWindow(HWindow, WX, WY, WW, WH, Repaint);
  205.  
  206.   { When one of the parameters is zero and the other unchanged, the
  207.     corresponding scrollbar is eliminated. }
  208.  
  209.   Scroller^.SetRange(XRange, Scroller^.YRange);
  210.   Scroller^.SetRange(Scroller^.XRange, YRange);
  211.   Scroller^.ScrollTo(0, 0);
  212. end;
  213.  
  214. { Update the screen display from the off-screen bitmap. Highlight the 
  215.   selection if there is one.
  216. }
  217. procedure TCanvas.Paint(PaintDC: HDC; var PaintInfo: TPaintStruct);
  218. var
  219.   R: TRect;            { The window client area }
  220. begin
  221.   { Copy from the off-screen bitmap to the screen }
  222.   GetClientRect(HWindow, R);
  223.   BitBlt(PaintDC, 0, 0, State^.BitmapSize.X, State^.BitmapSize.Y, 
  224.     State^.MemDC, 0, 0, SrcCopy);
  225.  
  226.   { Highlight the selection }  
  227.   PaintSelection(PaintDC, True);
  228. end;
  229.  
  230. { Highlight the selection, if there is one, by drawing a dotted line around
  231.   it. If there is a selection bitmap display it. Add the Offset in State
  232.   to the coordinates if requested.
  233. }
  234. procedure TCanvas.PaintSelection(DC: HDC; AddOffset: Boolean);
  235. var
  236.   SelDC: HDC;            { For the selection bitmap }
  237.   XOffset, YOffset: Integer;    { The offsets to be used }
  238. begin
  239.   if not IsRectEmpty(State^.Selection) then
  240.   begin
  241.     XOffset := 0;
  242.     YOffset := 0;
  243.     if AddOffset then
  244.     begin
  245.       XOffset := State^.Offset.X;
  246.       YOffset := State^.Offset.Y;
  247.     end;
  248.  
  249.     { Draw the selecton bitmap }
  250.     if State^.SelectionBM <> 0 then
  251.     begin
  252.  
  253.       { Set up the drawing context }
  254.       SelDC := CreateCompatibleDC(DC);
  255.       State^.SelectionBM := SelectObject(SelDC, State^.SelectionBM);
  256.  
  257.       { Copy the bits to the screen }
  258.       with State^.Selection do
  259.     BitBlt(DC, Left + XOffset, Top + YOffset, Right - Left,
  260.           Bottom - Top, SelDC, 0, 0, SrcCopy);
  261.  
  262.       { Clean up }
  263.       State^.SelectionBM := SelectObject(SelDC, State^.SelectionBM);
  264.       DeleteDC(SelDC);
  265.     end;
  266.  
  267.     { Draw a dotted line marking the selected area }
  268.     SetROP2(DC, r2_CopyPen);
  269.     SelectObject(DC, DashedPen);
  270.     SelectObject(DC, GetStockObject(Null_Brush));
  271.     with State^.Selection do
  272.       Rectangle(DC, Left + XOffset, Top + YOffset, Right + XOffset,
  273.         Bottom + YOffset);
  274.   end;
  275. end;
  276.  
  277. { Save the potentially modified portion of the current bitmap on the
  278.   undo bitmap and enable undoing.
  279. }
  280. procedure TCanvas.SaveUndo;
  281. begin
  282.   { Save the current bitmap as the undo bitmap }
  283.   BitBlt(UndoDC, 0, 0, State^.BitmapSize.X, State^.BitmapSize.Y,
  284.     State^.MemDC, 0, 0, SrcCopy);
  285.   EnableUndo;
  286. end;
  287.  
  288.  
  289. { Menu management }
  290. { Enable/Disable the cut/copy/delete menu items.
  291. }
  292. procedure TCanvas.EnableCCDMenu(mf_Flag: Integer);
  293. var
  294.   Menu: HMenu;
  295. begin
  296.   Menu := GetMenu(Parent^.HWindow);
  297.   EnableMenuItem(Menu, cm_EditCut, mf_Flag);
  298.   EnableMenuItem(Menu, cm_EditCopy, mf_Flag);
  299.   EnableMenuItem(Menu, cm_EditDelete, mf_Flag);
  300. end;
  301.  
  302. procedure TCanvas.EnableCCD;
  303. begin
  304.   EnableCCDMenu(mf_Enabled);
  305. end;
  306.  
  307. procedure TCanvas.DisableCCD;
  308. begin
  309.   EnableCCDMenu(mf_Grayed);
  310. end;
  311.  
  312. { Enable/Disable the undo menu item.
  313. }
  314. procedure TCanvas.EnableUndoMenu(mf_Flag: Integer);
  315. var
  316.   Menu: HMenu;
  317. begin
  318.   Menu := GetMenu(Parent^.HWindow);
  319.   ModifyMenu(Menu, cm_EditUndo, mf_ByCommand or mf_String,
  320.     cm_EditUndo, '&Undo');
  321.   EnableMenuItem(Menu, cm_EditUndo, mf_Flag);
  322. end;
  323.  
  324. procedure TCanvas.EnableUndo;
  325. begin
  326.   EnableUndoMenu(mf_Enabled);
  327. end;
  328.   
  329. procedure TCanvas.DisableUndo;
  330. begin
  331.   EnableUndoMenu(mf_Grayed);
  332. end;
  333.  
  334. procedure TCanvas.ResetUndoLabel(NewLabel: PChar);
  335. begin
  336.   ModifyMenu(GetMenu(Parent^.HWindow), cm_EditUndo, mf_ByCommand or mf_String,
  337.     cm_EditUndo, NewLabel);
  338. end;
  339.  
  340.  
  341. { Menu initiated functions }
  342. { File }
  343.  
  344. { Undo the last change to the current bitmap and toggle the undo/redo menu
  345.   item.
  346. }
  347. procedure TCanvas.Undo;
  348. var
  349.   MLabel: String[6];         { The current undo/redo label }
  350.   R: TRect;            { The window client area }
  351. begin
  352.   { Swap the bitmaps in the DCs }
  353.   Bitmap := SelectObject(State^.MemDC, SelectObject(UndoDC,
  354.     SelectObject(State^.MemDC, Bitmap)));
  355.  
  356.   { Reset the undo/redo label }
  357.   GetMenuString(GetMenu(Parent^.HWindow), cm_EditUndo, @MLabel, 6,
  358.     mf_ByCommand);
  359.   if StrComp(@MLabel, '&Undo') = 0 then
  360.     ResetUndoLabel('&Redo')
  361.   else
  362.     ResetUndoLabel('&Undo');
  363.  
  364.   { Update the screen }
  365.   GetClientRect(HWindow, R);
  366.   InvalidateRect(HWindow, @R, False);
  367. end;  
  368.  
  369. { Read a bitmap from a file into the current drawing canvas. Returns 0 on 
  370.   error, otherwise non-zero.
  371. }
  372. function TCanvas.Load(FileName: PChar): Integer;
  373.  
  374.   function Smaller(A, B: Integer): Integer;
  375.   begin
  376.     if A < B then Smaller := A else Smaller := B;
  377.   end;
  378.  
  379. var
  380.   HBM: HBitmap;            { The new bitmap }
  381.   BM: TBitmap;            { Information about the new bitmap }
  382. begin
  383.   Load := 1;
  384.  
  385.   { Actually read in the bitmap }
  386.   HBM := LoadBitmapFile(FileName);
  387.   if HBM = 0 then        { Failure }
  388.   begin
  389.     Load := 0;
  390.     Tell('Unable to read bitmap.');
  391.     exit;
  392.   end;
  393.  
  394.   { Mark the bitmap as unmodified, and clear the selection }
  395.   State^.IsDirtyBitmap := False;
  396.   DisableUndo;
  397.   SetRectEmpty(State^.Selection);
  398.  
  399.   { Reconfigure the world to suit the new bitmap size }
  400.   GetObject(HBM, sizeOf(BM), @BM);    { Information about the new bitmap }
  401.   with State^.BitmapSize do
  402.   begin
  403.     X := BM.bmWidth;
  404.     Y := BM.bmHeight;
  405.   end;
  406.   DeleteObject(SelectObject(State^.MemDC, HBM));
  407.   DeleteObject(SelectObject(UndoDC, CreateCompatibleBitmap(UndoDC,
  408.     State^.BitmapSize.X, State^.BitmapSize.Y)));
  409. end;
  410.  
  411. { Write the current image out to a file. Returns 0 if error, otherwise
  412.   non-zero.
  413. }
  414. function TCanvas.Store(FileName: PChar): Integer;
  415. var 
  416.   I: Integer;            { Result from the actual write }
  417. begin
  418.   { Retrieve the actual bitmap from the State display context }
  419.   Bitmap := SelectObject(State^.MemDC, Bitmap);
  420.   I := StoreBitmapFile(FileName, Bitmap);
  421.   
  422.   { Restore the off-screen bitmap to the State display context }
  423.   Bitmap := SelectObject(State^.MemDC, Bitmap);
  424.  
  425.   State^.IsDirtyBitmap := I <> 1; { Mark the bitmap unmodified if successful }
  426.   DisableUndo;
  427.   Store := I;
  428. end;
  429.  
  430. { Edit }
  431.  
  432. { Copy the indicated bits of bitmap in the drawing context to the clipboard.
  433.   Copying to the clipboard is done by transferring a bitmap to the clipboard.
  434.   Once the clipboard has been passed this bitmap, it is no longer owned by
  435.   the application, so a new bitmap is created expressly for this purpose.
  436. }
  437. procedure TCanvas.CopyToClipBoard(DC: HDC; Left, Top, Width, Height: Integer);
  438. var
  439.   CopyDC: HDC;            { For the new bitmap }
  440.   CopyBitmap: HBitmap;        { The new bitmap }
  441. begin
  442.   { Make sure clipboard is available and can be copied to }
  443.   if OpenClipBoard(HWindow) and EmptyClipBoard then
  444.   begin
  445.  
  446.     { Create the new bitmap }
  447.     CopyDC := CreateCompatibleDC(DC);
  448.     CopyBitmap := CreateCompatibleBitmap(DC, Width, Height);
  449.     CopyBitmap := SelectObject(CopyDC, CopyBitmap);
  450.     BitBlt(CopyDC, 0, 0, Width, Height, DC, Left, Top, SrcCopy);
  451.     CopyBitmap := SelectObject(CopyDC, CopyBitmap);
  452.  
  453.     { Transfer the new bitmap to the clipboard }
  454.     SetClipBoardData(cf_Bitmap, CopyBitmap);
  455.  
  456.     { Clean up }
  457.     CloseClipBoard;
  458.     DeleteDC(CopyDC);
  459.   end;
  460. end;
  461.  
  462. { White out the rectangle indicated on the off-screen bitmap.
  463. }
  464. procedure TCanvas.Erase(Left, Top, Width, Height: Integer);
  465. begin
  466.   { White out the rectangle }
  467.   PatBlt(State^.MemDC, Left, Top, Width, Height, Whiteness);
  468. end;
  469.  
  470. { Make the current selection into a selection bitmap. Note that this should
  471.   (and can be) only invoked when the SelectTool is active. (Otherwise there
  472.   could be no selection.
  473. }
  474. procedure TCanvas.PickUpSelection(aDC: HDC; Left, Top, Width, Height: Integer);
  475. begin
  476.   State^.PaintTool^.PickUpSelection(aDC, Left, Top, Width, Height);
  477. end;
  478.  
  479. { Release the current selection without saving the bits. Also gray out the
  480.   appropriate menu items.
  481. }
  482. procedure TCanvas.ReleaseSelection;
  483. begin
  484.   State^.PaintTool^.ReleaseSelection;
  485.   DisableCCD;
  486. end;
  487.  
  488. { Copy the current selection to the clipboard and white out the hole.
  489. }
  490. procedure TCanvas.Cut;
  491. begin
  492.   Copy;
  493.   Delete;
  494. end;
  495.  
  496. { Copy the current selection to the clipboard.
  497. }
  498. procedure TCanvas.Copy;
  499. begin
  500.   if State^.SelectionBM <> 0 then
  501.     
  502.     { Use the selection bitmap }
  503.     begin
  504.       State^.SelectionBM := SelectObject(State^.MemDC, State^.SelectionBM);
  505.       with State^.Selection do
  506.         CopyToClipBoard(State^.MemDC, 0, 0, Right-Left, Bottom-Top);
  507.       State^.SelectionBM := SelectObject(State^.MemDC, State^.SelectionBM);
  508.     end
  509.   else
  510.     
  511.     { Copy from the off-screen bitmap }
  512.     begin
  513.       with State^.Selection do
  514.         CopyToClipBoard(State^.MemDC, Left, Top, Right-Left, Bottom-Top);
  515.     end;
  516.     DisableUndo;
  517. end;
  518.  
  519. { Retrieve what is in the clipboard and make it the current selection bitmap.
  520.   The clipboard retains ownership of the retrieved bitmap, so it must be
  521.   copied into a new selection bitmap.
  522. }
  523. procedure TCanvas.Paste;
  524. var
  525.   DC, ClipDC: HDC;        { For screen and clipboard bitmaps }
  526.   ClipBitmap: HBitmap;        { The clipboard bitmap }
  527.   BM: TBitmap;            { Information on the clipboard bitmap }
  528. begin
  529.  
  530.   { Make sure the clipboard is available }
  531.   if OpenClipBoard(HWindow) then
  532.   begin
  533.  
  534.     { Set up the drawing contexts }
  535.     DC := GetDC(HWindow);
  536.     ClipDC := CreateCompatibleDC(DC);
  537.  
  538.     { Retrieve the clipboard bitmap }
  539.     ClipBitmap := GetClipBoardData(cf_Bitmap);
  540.     CloseClipBoard;
  541.  
  542.     { Make sure the retrieve succeeded and make it the selection bitmap }
  543.     if (ClipBitmap <> 0) and
  544.        { Get information about the bitmap }
  545.        (GetObject(ClipBitmap, SizeOf(TBitmap), @BM) <> 0) then
  546.     begin
  547.       ClipBitmap := SelectObject(ClipDC, ClipBitmap);
  548.       PickUpSelection(ClipDC, 0, 0, bm.bmWidth, bm.bmHeight);
  549.       ClipBitmap := SelectObject(ClipDC, ClipBitmap);
  550.       PaintSelection(DC, False);
  551.       DisableUndo;
  552.     end;
  553.  
  554.     { Clean up }
  555.     DeleteDC(ClipDC);
  556.     ReleaseDC(HWindow, DC);
  557.   end;
  558. end;
  559.  
  560. { White out the selected area or release the selection bitmap.
  561. }
  562. procedure TCanvas.Delete;
  563. begin
  564.   SaveUndo;
  565.   if State^.SelectionBM = 0 then
  566.     with State^.Selection do
  567.       Erase(Left, Top, Right-Left, Bottom-Top);
  568.   ReleaseSelection;
  569. end;
  570.  
  571. { White out the entire canvas.
  572. }
  573. procedure TCanvas.ClearAll;
  574. var
  575.   R: TRect;            { The window client area }
  576. begin
  577.   SaveUndo;
  578.   GetClientRect(HWindow, R);
  579.   InvalidateRect(HWindow, @R, False);
  580.   ReleaseSelection;
  581.   Erase(0, 0, State^.BitmapSize.X, State^.BitmapSize.Y);
  582. end;
  583.  
  584. { Options }
  585. { Resize the current bitmap by creating a new bitmap and copying the
  586.   contents of the current bitmap into it according to flag.
  587. }
  588. procedure TCanvas.Resize(CopyFlag: Integer);
  589. var
  590.   OBitmap: HBitmap;
  591.   DC: HDC;
  592. begin
  593.   DisableUndo;
  594.   OBitmap := SelectObject(State^.MemDC, Bitmap);
  595.   UndoBitmap := SelectObject(UndoDC, UndoBitmap);
  596.   DeleteObject(UndoBitmap);
  597.  
  598.   DC := GetDC(HWindow);
  599.   NewBitmaps(DC);
  600.   ReleaseDC(HWindow, DC);
  601.  
  602.   BitmapCopy(OBitmap, CopyFlag);
  603.  
  604.   DeleteObject(OBitmap);
  605. end;
  606.  
  607. { Copy the contents of bitmap into the current bitmap according to flag.
  608. }
  609. procedure TCanvas.BitmapCopy(aBitmap: HBitmap; CopyFlag: Integer);
  610. var
  611.   CopyDC: HDC;
  612.   BMinfo: TBitmap;
  613. begin
  614.   GetObject(aBitmap, SizeOf(TBitmap), @BMInfo);
  615.   CopyDC := CreateCompatibleDC(State^.MemDC);
  616.   aBitmap := SelectObject(CopyDC, aBitmap);
  617.   case CopyFlag of
  618.     id_StretchBM:
  619.       begin
  620.     StretchBlt(State^.MemDC, 0, 0, State^.BitmapSize.X,
  621.           State^.BitmapSize.Y, CopyDC, 0, 0, BMInfo.bmWidth,
  622.           BMInfo.bmHeight, SrcCopy);
  623.       end;
  624.     id_PadBM:
  625.       BitBlt(State^.MemDC, 0, 0, State^.BitmapSize.X, State^.BitmapSize.Y,
  626.         CopyDC, 0, 0, SrcCopy);
  627.   end;
  628.   aBitmap := SelectObject(CopyDC, aBitmap);
  629.   DeleteDC(CopyDC);  
  630. end;
  631.  
  632. { Window manager responses }
  633. { Mouse initiated actions }
  634.  
  635. { Start the selected drawing tool drawing.
  636. }
  637. procedure TCanvas.WMLButtonDown(var Msg: TMessage);
  638. begin
  639.   if not Drawing then
  640.   begin
  641.     { Let subsequent Mouse Moves and Mouse Ups know that drawing is in 
  642.       progress, i.e., that the initial mouse down occurred in the right
  643.       window.
  644.     }
  645.     Drawing := True;
  646.  
  647.     SaveUndo;
  648.     if IsRectEmpty(State^.Selection) then
  649.       State^.IsDirtyBitmap := True
  650.     else
  651.       DisableUndo;
  652.  
  653.     { Tell the current tool to start drawing }
  654.     State^.PaintTool^.MouseDown(HWindow, Integer(Msg.LParamLo),
  655.       Integer(Msg.LParamHi), State);
  656.   end;
  657. end;
  658.  
  659. { If drawing is in progress, tell the currently selected tool about the
  660.   Mouse Move.
  661. }
  662. procedure TCanvas.WMMouseMove(var Msg: TMessage);
  663. begin
  664.    if Drawing then
  665.        State^.PaintTool^.MouseMove(Integer(Msg.LParamLo),
  666.      Integer(Msg.LParamHi));
  667. end;
  668.  
  669. { If drawing is in progress, record the altered state of the image by either
  670.   copying the screen bitmap to the off-screen bitmap or high-lighting the
  671.   new selection. Tell the currently selected tool that the mouse is up.
  672.   Enable/disable menus appropriately.
  673. }
  674. procedure TCanvas.WMLButtonUp(var Msg: TMessage);
  675. var
  676.   DC: HDC;                { For the screen bitmap }
  677.   Menu: HMenu;                { For the window menu }
  678. begin
  679.   if Drawing then
  680.   begin
  681.     State^.PaintTool^.MouseUp;
  682.     Drawing := False;
  683.     Menu := GetMenu(Parent^.HWindow);
  684.     if IsRectEmpty(State^.Selection) then
  685.     begin
  686.       DisableCCD;
  687.       EnableUndo;
  688.     end
  689.     else
  690.     begin
  691.       DC := GetDC(HWindow);
  692.       PaintSelection(DC, False);
  693.       ReleaseDC(HWindow, DC);
  694.       EnableCCD;
  695.       DisableUndo;
  696.     end;
  697.   end;
  698. end;
  699.  
  700. { When the cursor is over the canvas, change the cursor to the cursor
  701.   associated with the selected tool. If the cursor is over the selection
  702.   use the standard arrow cursor.
  703. }
  704. procedure TCanvas.WMSetCursor(var Msg: TMessage);
  705. var
  706.   Pt: TPoint;            { Cursor position }
  707.   R: TRect;            { Window client area }
  708. begin
  709.   GetCursorPos(Pt);        { In global coordinates }
  710.   ScreenToClient(HWindow, Pt);  { In window client local coordinates }
  711.   GetClientRect(HWindow, R);
  712.   if not(PtInRect(R, Pt)) or PtInRect(State^.Selection, Pt) then
  713.     SetCursor(LoadCursor(0, idc_Arrow))
  714.   else
  715.     SetCursor(State^.PaintTool^.Cursor)
  716. end;
  717.  
  718. { TCanvasScroller }
  719. procedure TCanvasScroller.BeginView(PaintDC: HDC; var PaintInfo: TPaintStruct);
  720. var
  721.   R: TRect;
  722.   DX, DY: Integer;
  723. begin
  724.   TScroller.BeginView(PaintDC, PaintInfo);
  725.   with PCanvas(Window)^.State^ do
  726.   begin
  727.     DX := XPos - Offset.X;
  728.     DY := YPos - Offset.Y;
  729.     if not(IsRectEmpty(Selection)) then
  730.       with Selection do
  731.     SetRect(Selection, Left - DX, Top - DY, Right - DX, Bottom - DY);
  732.     Offset.X := XPos;
  733.     Offset.Y := YPos;
  734.   end;
  735. end;
  736.  
  737. end.